Developer CD Series 2000 November: Tool Chest/Dev.CD Nov 00 TC Disk 1.toast/Sample Code/Devices and Hardware/Drivers/TradDriverLoaderLib/TestTradDriverLoader.p

Text File | 2000-09-28 | 6.9 KB | 254 lines | [TEXT/CWIE]

program TestTradDriverLoaderLib;
(*
    File:        TestTradDriverLoaderLib.p

    Description:Pascal program to test TradDriverLoaderLib.

    Author:        Quinn

    Copyright:     Copyright: © 1996-1999 by Apple Computer, Inc.
                all rights reserved.

    Disclaimer:    You may incorporate this sample code into your applications without
                restriction, though the sample code has been provided "AS IS" and the
                responsibility for its operation is 100% yours.  However, what you are
                not permitted to do is to redistribute the source as "DSC Sample Code"
                after having made changes. If you're going to re-distribute the source,
                we require that you make it clear in the source that the code was
                descended from Apple Sample Code, but that you've made changes.

    Change History (most recent first):
                6/24/99    Updated for Metrowerks Codewarror Pro 2.1(KG)

*)
    uses
        Types,
        LowMem,
        Files,
        Devices,

        TradDriverLoaderLib;

    procedure CheckTestResult(err : OSErr; mesg : Str255);
    begin
        if err = noErr then begin
            writeln('  Passed ', mesg, '.');
        end else begin
            writeln('  •••Failed ', mesg, ' with error ', err:1, '.');
        end; (* if *)
    end; (* CheckTestResult *)

    procedure CheckTestResultBool(b : Boolean; mesg : Str255);
    begin
        if b then begin
            writeln('  Passed ', mesg, '.');
        end else begin
            writeln('  •••Failed ', mesg, '.');
        end; (* if *)
    end; (* CheckTestResultBool *)

    procedure TestTradHighestUnitNumber;
    begin
        writeln('TestTradHighestUnitNumber');
        writeln;
        CheckTestResultBool( TradHighestUnitNumber = (LMGetUnitTableEntryCount - 1) , 'check against LMGetUnitTableEntryCount');
    end; (* TestTradHighestUnitNumber *)

    procedure TestInstallOpenRemove;
        var
            err : OSErr;
            rsrcName : Str255;
            refNum : DriverRefNum;
            cpb : CntrlParam;
    begin
        writeln('TestInstallOpenRemove');
        writeln;

        (* Install *)
        rsrcName := '.Test';
        err := TradInstallDriverFromResource(0, @rsrcName, 48, TradHighestUnitNumber() + 1, refNum);
        CheckTestResult(err, 'install');

        (* Open *)
        if err = noErr then begin
            err := TradOpenInstalledDriver(refNum, fsRdWrPerm);
            CheckTestResult(err, 'open');
        end; (* if *)

        (* Functional *)
        if err = noErr then begin
            cpb.ioCRefNum := refNum;
            cpb.csCode := 666;
            err := PBStatusSync(@cpb);
            CheckTestResult(err, 'status call');
        end; (* if *)
        if err = noErr then begin
            CheckTestResultBool(cpb.csParam[0] = refNum, 'results from status call');
        end; (* if *)

        (* Remove *)
        if err = noErr then begin
            err := TradRemoveDriver(refNum, false);
            CheckTestResult(err, 'remove');
        end; (* if *)

        writeln;
    end; (* TestInstallOpenRemove *)

    procedure TestGestaltCalls;
        var
            rsrcName : Str255;
            err : OSErr;
            refNum : DriverRefNum;
            flags : DriverFlags;
    begin
        writeln('TestGestaltCalls');
        writeln;

        (* Install *)
        rsrcName := '.Test';
        err := TradInstallDriverFromResource(0, @rsrcName, 48, TradHighestUnitNumber() + 1, refNum);
        CheckTestResult(err, 'install');

        (* Open *)
        if err = noErr then begin
            err := TradOpenInstalledDriver(refNum, fsRdWrPerm);
            CheckTestResult(err, 'open');
        end; (* if *)

        (* Gestalt On *)
        if err = noErr then begin
            err := TradDriverGestaltOn(refNum);
            CheckTestResult(err, 'set Gestalt on');
        end; (* if *)
        if err = noErr then begin
            err := TradGetDriverInformation(refNum, nil, @flags, nil, nil);
            CheckTestResultBool((err = noErr) & TradDriverGestaltIsOn(flags), 'confirm Gestalt on');
        end; (* if *)

        (* Gestalt Off *)
        if err = noErr then begin
            err := TradDriverGestaltOff(refNum);
            CheckTestResult(err, 'set Gestalt off');
        end; (* if *)
        if err = noErr then begin
            err := TradGetDriverInformation(refNum, nil, @flags, nil, nil);
            CheckTestResultBool((err = noErr) & not TradDriverGestaltIsOn(flags), 'confirm Gestalt off');
        end; (* if *)

        (* Remove *)
        if err = noErr then begin
            err := TradRemoveDriver(refNum, false);
            CheckTestResult(err, 'remove');
        end; (* if *)

        writeln;
    end; (* TestGestaltCalls *)


    procedure TestInfoCalls;
        var
            err : OSErr;
            refNumsCount : ItemCount;
            i : ItemCount;
            refNums : packed array [0..999] of DriverRefNum;
            thisUnit : UnitNumber;
            flags : DriverFlags;
            name : Str255;
            driverHeader : DRVRHeaderPtr;
    begin
        writeln('TestInfoCalls');
        writeln;

        refNumsCount := 1000;
        err := TradLookupDrivers(0, TradHighestUnitNumber, false, refNumsCount, @refNums[0]);
        CheckTestResult(err, 'lookup drivers');
        if err = noErr then begin
            for i := 0 to refNumsCount - 1 do begin
                err := TradGetDriverInformation(refNums[i], @thisUnit, @flags, @name, @driverHeader);
                if err = noErr then begin
                    writeln('  refNum=', refNums[i]:1, ', unit=', thisUnit:1, ', flags=', (ord4(flags)),
                                    ', name=“', name, '”, addr=', ord4(driverHeader));
                end else begin
                    writeln('  •••Error ', err:1, ' getting info for refnum ', refNums[i]:1, '.');
                end; (* if *)
            end; (* for *)
        end; (* if *)

        writeln;
    end; (* TestInfoCalls *)

    procedure TestAddLots;
        var
            err : OSErr;
            refNum : DriverRefNum;
            highChar : char;
            lowChar : char;
            rsrcName : Str255;
    begin
        writeln('TestAddLots');
        writeln;

        (* Add 2 * 26 = 52) drivers to the unit table and open them all!
                Have to stop before 'T' otherwise our unique names clash with '.Test'.
                Note that this is limited by kMaximumNumberOfUnitTableEntries defined
                in TradDriverLoaderLib.c.
        *)

        for highChar := 'A' to 'B' do begin
            for lowChar := 'A' to 'Z' do begin
                rsrcName := '.Test';
                err := TradInstallDriverFromResource(0, @rsrcName, 48, TradHighestUnitNumber() + 1, refNum);
                if err = noErr then begin
                    rsrcName[2] := highChar;
                    rsrcName[3] := lowChar;
                    err := TradRenameDriver(refNum, rsrcName);
                end; (* if *)
                if err = noErr then begin
                    err := TradOpenInstalledDriver(refNum, fsRdWrPerm);
                end; (* if *)
                if err <> noErr then begin
                    writeln('  •••Adding lots failed at ''', highChar, lowChar, ''' with error ', err:1, '.');
                    exit(TestAddLots);
                end; (* if *)
            end; (* for *)
        end; (* for *)

        writeln('  Drivers added successfully!');

        (* Remove all of the added units. *)

        for highChar := 'A' to 'B' do begin
            for lowChar := 'A' to 'Z' do begin
                rsrcName := '.Test';
                rsrcName[2] := highChar;
                rsrcName[3] := lowChar;
                err := OpenDriver(rsrcName, refNum);
                if err = noErr then begin
                    err := TradRemoveDriver(refNum, false);
                end; (* if *)
                if err <> noErr then begin
                    writeln('  •••Removing lots failed at ''', highChar, lowChar, ''' with error ', err:1, '.');
                    exit(TestAddLots);
                end; (* if *)
            end; (* for *)
        end; (* for *)

        writeln('  Drivers removed successfully!');

        writeln;
    end; (* TestAddLots *)

begin
    writeln('Hello Cruel World!');
    writeln;
    writeln('TestTradDriverLoaderLib');
    writeln('-- a test tool for the TradDriverLoaderLib library.');
    writeln;
    TestInstallOpenRemove;
    TestGestaltCalls;
    TestInfoCalls;
    TestAddLots;
    writeln('Done.  Press command-Q to Quit.');
end. (* TestTradDriverLoaderLib *)